home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Languages
/
PowerMacOberon 1.2
/
Source
/
Coco⁄R
/
CR.ATG
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1995-08-22
|
19KB
|
330 lines
Courier10.Scn.Fnt
Syntax10.Scn.Fnt
COMPILER CR (*Coco/R*)
(*---------------------- semantic declarations ----------------------------*)
IMPORT CRT, CRA, CRX, Sets, Texts, Oberon;
CONST
ident = 0; string = 1; (*symbol kind*)
str: ARRAY 32 OF CHAR;
w: Texts.Writer;
genScanner: BOOLEAN;
PROCEDURE SemErr(nr: INTEGER);
BEGIN
CRS.Error(200+nr, CRS.pos);
END SemErr;
PROCEDURE MatchLiteral(sp: INTEGER); (*store string either as token or as literal*)
VAR sn, sn1: CRT.SymbolNode; matchedSp: INTEGER;
BEGIN
CRT.GetSym(sp, sn);
CRA.MatchDFA(sn.name, sp, matchedSp);
IF matchedSp # CRT.noSym THEN
CRT.GetSym(matchedSp, sn1); sn1.struct := CRT.classLitToken; CRT.PutSym(matchedSp, sn1);
sn.struct := CRT.litToken
ELSE sn.struct := CRT.classToken;
END;
CRT.PutSym(sp, sn)
END MatchLiteral;
PROCEDURE SetCtx(gp: INTEGER); (*set transition code to CRT.contextTrans*)
VAR gn: CRT.GraphNode;
BEGIN
WHILE gp > 0 DO
CRT.GetNode(gp, gn);
IF gn.typ IN {CRT.char, CRT.class} THEN
gn.p2 := CRT.contextTrans; CRT.PutNode(gp, gn)
ELSIF gn.typ IN {CRT.opt, CRT.iter} THEN SetCtx(gn.p1)
ELSIF gn.typ = CRT.alt THEN SetCtx(gn.p1); SetCtx(gn.p2)
END;
gp := gn.next
END
END SetCtx;
PROCEDURE SetDDT(s: ARRAY OF CHAR);
VAR name: ARRAY 64 OF CHAR; i: INTEGER; ch: CHAR;
BEGIN
i := 1;
WHILE s[i] # 0X DO
ch := s[i]; INC(i);
IF (ch >= "0") & (ch <= "9") THEN CRT.ddt[ORD(ch)-ORD("0")] := TRUE END
END
END SetDDT;
PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER);
VAR double: BOOLEAN; i: INTEGER;
BEGIN
double := FALSE;
FOR i := 0 TO len-2 DO
IF s[i] = '"' THEN double := TRUE ELSIF s[i] = " " THEN SemErr(24) END
END;
IF ~ double THEN s[0] := '"'; s[len-1] := '"' END
END FixString;
(*-------------------------------------------------------------------------*)
CHARACTERS
letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".
digit = "0123456789".
eol = CHR(13).
tab = CHR(9).
noQuote1 = ANY - '"' - eol.
noQuote2 = ANY - "'" - eol.
IGNORE eol + tab + CHR(28)
TOKENS
ident = letter {letter | digit}.
string = '"' {noQuote1} '"' | "'" {noQuote2} "'".
number = digit {digit}.
PRAGMAS
ddtSym = "$" {digit}. (. CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str) .)
COMMENTS FROM "(*" TO "*)" NESTED
(*-------------------------------------------------------------------------*)
PRODUCTIONS
CR (. VAR undef, hasAttrs, ok, ok1: BOOLEAN; eofSy, gR: INTEGER;
gramLine, sp: INTEGER;
gn: CRT.GraphNode; sn: CRT.SymbolNode;
name, gramName: CRT.Name; .)
"COMPILER" (. Texts.OpenWriter(w);
CRT.Init; CRX.Init; CRA.Init;
gramLine := CRS.line;
eofSy := CRT.NewSym(CRT.t, "EOF", 0);
genScanner := TRUE;
CRT.ignoreCase := FALSE;
ok := TRUE;
Sets.Clear(CRT.ignored) .)
ident (. CRS.GetName(CRS.pos, CRS.len, gramName);
CRT.semDeclPos.beg := CRS.nextPos; CRT.importPos.beg := -1; .)
{ "IMPORT" (. CRT.importPos.beg := CRS.nextPos .)
{ANY} ";" (. CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg);
CRT.importPos.col := 0;
CRT.semDeclPos.beg := CRS.nextPos .)
| ANY
} (. CRT.semDeclPos.len := SHORT(CRS.nextPos - CRT.semDeclPos.beg);
CRT.semDeclPos.col := 0 .)
{ Declaration }
SYNC
"PRODUCTIONS" (. IF genScanner THEN CRA.MakeDeterministic(ok) END;
CRT.nNodes := 0 .)
{ ident (. CRS.GetName(CRS.pos, CRS.len, name);
sp := CRT.FindSym(name); undef := sp = CRT.noSym;
IF undef THEN
sp := CRT.NewSym(CRT.nt, name, CRS.line);
CRT.GetSym(sp, sn);
ELSE
CRT.GetSym(sp, sn);
IF sn.typ = CRT.nt THEN
IF sn.struct > 0 THEN SemErr(7) END
ELSE SemErr(8)
END;
sn.line := CRS.line
END;
hasAttrs := sn.attrPos.beg >= 0 .)
( Attribs <sn.attrPos> (. IF ~undef & ~hasAttrs THEN SemErr(9) END;
CRT.PutSym(sp, sn) .)
| (. IF ~undef & hasAttrs THEN SemErr(10) END .)
)
[ SemText <sn.semPos>]
WEAK "="
Expression <sn.struct, gR> (. CRT.CompleteGraph(gR); CRT.PutSym(sp, sn);
IF CRT.ddt[2] THEN CRT.PrintGraph END .)
WEAK "."
} (. sp := CRT.FindSym(gramName);
IF sp = CRT.noSym THEN SemErr(11);
ELSE
CRT.GetSym(sp, sn);
IF sn.attrPos.beg >= 0 THEN SemErr(12) END;
CRT.root := CRT.NewNode(CRT.nt, sp, gramLine);
END .)
"END" ident (. CRS.GetName(CRS.pos, CRS.len, name);
IF name # gramName THEN SemErr(17) END;
IF CRS.errors = 0 THEN
Texts.WriteString(w, " checking"); Texts.Append(Oberon.Log, w.buf);
CRT.CompSymbolSets;
IF ok THEN CRT.TestCompleteness(ok) END;
IF ok THEN
CRT.TestIfAllNtReached(ok1); CRT.FindCircularProductions(ok)
END;
IF ok THEN CRT.TestIfNtToTerm(ok) END;
IF ok THEN CRT.LL1Test(ok1) END;
IF CRT.ddt[0] THEN CRA.PrintStates END;
IF CRT.ddt[7] THEN CRT.XRef END;
IF ok THEN
Texts.WriteString(w, " +parser");
Texts.Append(Oberon.Log, w.buf);
CRX.GenCompiler;
IF genScanner THEN
Texts.WriteString(w, " +scanner");
Texts.Append(Oberon.Log, w.buf);
CRA.WriteScanner
END;
IF CRT.ddt[8] THEN CRX.WriteStatistics END
END
ELSE ok := FALSE
END;
IF CRT.ddt[6] THEN CRT.PrintSymbolTable END;
IF ok THEN Texts.WriteString(w, " done") END;
Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) .)
".".
(*------------------------------------------------------------------------------------*)
Declaration (. VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN; .)
"CHARACTERS" { SetDecl }
| "TOKENS" { TokenDecl <CRT.t> }
| "PRAGMAS" { TokenDecl <CRT.pr> }
| "COMMENTS"
"FROM" TokenExpr <gL1, gR1>
"TO" TokenExpr <gL2, gR2>
( "NESTED" (. nested := TRUE .)
| (. nested := FALSE .)
) (. CRA.NewComment(gL1, gL2, nested) .)
| "IGNORE"
( "CASE" (. CRT.ignoreCase := TRUE .)
| Set <CRT.ignored>
(*------------------------------------------------------------------------------------*)
SetDecl (. VAR c: INTEGER; set: CRT.Set; name: CRT.Name; .)
ident (. CRS.GetName(CRS.pos, CRS.len, name);
c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END .)
"=" Set <set> (. c := CRT.NewClass(name, set) .)
".".
(*------------------------------------------------------------------------------------*)
Set <VAR set: CRT.Set> (. VAR set2: CRT.Set; .)
SimSet <set>
{ "+" SimSet <set2> (. Sets.Unite(set, set2) .)
| "-" SimSet <set2> (. Sets.Differ(set, set2) .)
(*------------------------------------------------------------------------------------*)
SimSet <VAR set: CRT.Set> (. VAR c, n, i: INTEGER; name: CRT.Name; s: ARRAY 128 OF CHAR; .)
ident (. CRS.GetName(CRS.pos, CRS.len, name);
c := CRT.ClassWithName(name);
IF c < 0 THEN SemErr(15); Sets.Clear(set)
ELSE CRT.GetClass(c, set)
END .)
| string (. CRS.GetName(CRS.pos, CRS.len, s);
Sets.Clear(set); i := 1;
WHILE s[i] # s[0] DO
Sets.Incl(set, ORD(s[i])); INC(i)
END .)
| "CHR" "(" number (. CRS.GetName(CRS.pos, CRS.len, name);
n := 0; i := 0;
WHILE name[i] # 0X DO
n := 10 * n + (ORD(name[i]) - ORD("0"));
INC(i)
END;
Sets.Clear(set); Sets.Incl(set, n) .)
")"
| "ANY" (. Sets.Fill(set) .)
(*------------------------------------------------------------------------------------*)
TokenDecl <typ: INTEGER> (. VAR sp, kind, gL, gR: INTEGER; sn: CRT.SymbolNode;
pos: CRT.Position; name: CRT.Name; .)
Symbol <name, kind> (. IF CRT.FindSym(name) # CRT.noSym THEN SemErr(7)
ELSE
sp := CRT.NewSym(typ, name, CRS.line);
CRT.GetSym(sp, sn); sn.struct := CRT.classToken;
CRT.PutSym(sp, sn)
END .)
SYNC
( "=" TokenExpr <gL, gR> "." (. IF kind # ident THEN SemErr(13) END;
CRT.CompleteGraph(gR);
CRA.ConvertToStates(gL, sp) .)
| (. IF kind = ident THEN genScanner := FALSE
ELSE MatchLiteral(sp)
END .)
[ SemText <pos> (. IF typ = CRT.t THEN SemErr(14) END;
CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) .)
(*------------------------------------------------------------------------------------*)
Expression <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .)
Term <gL, gR> (. first := TRUE .)
{ WEAK "|"
Term <gL2, gR2> (. IF first THEN
CRT.MakeFirstAlt(gL, gR); first := FALSE
END;
CRT.ConcatAlt(gL, gR, gL2, gR2) .)
(*------------------------------------------------------------------------------------*)
Term<VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; .)
= (. gL := 0; gR := 0 .)
( Factor <gL, gR>
{ Factor <gL2, gR2> (. CRT.ConcatSeq(gL, gR, gL2, gR2) .)
}
| (. gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL .)
(*------------------------------------------------------------------------------------*)
Factor <VAR gL, gR: INTEGER> (. VAR sp, kind, c: INTEGER; name: CRT.Name;
gn: CRT.GraphNode; sn: CRT.SymbolNode;
set: CRT.Set;
undef, weak: BOOLEAN;
pos: CRT.Position; .)
(. gL :=0; gR := 0; weak := FALSE .)
( [ "WEAK" (. weak := TRUE .)
Symbol <name, kind> (. sp := CRT.FindSym(name); undef := sp = CRT.noSym;
IF undef THEN
IF kind = ident THEN (*forward nt*)
sp := CRT.NewSym(CRT.nt, name, 0)
ELSE (*undefined string in production*)
sp := CRT.NewSym(CRT.t, name, CRS.line);
MatchLiteral(sp)
END
END;
CRT.GetSym(sp, sn);
IF ~(sn.typ IN {CRT.t,CRT.nt}) THEN SemErr(4) END;
IF weak THEN
IF sn.typ = CRT.t THEN sn.typ := CRT.wt ELSE SemErr(23) END
END;
gL := CRT.NewNode(sn.typ, sp, CRS.line); gR := gL .)
( Attribs <pos> (. CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn);
CRT.GetSym(sp, sn);
IF undef THEN
sn.attrPos := pos; CRT.PutSym(sp, sn)
ELSIF sn.attrPos.beg < 0 THEN SemErr(5)
END;
IF kind # ident THEN SemErr(3) END .)
| (. CRT.GetSym(sp, sn);
IF sn.attrPos.beg >= 0 THEN SemErr(6) END .)
| "(" Expression <gL, gR> ")"
| "[" Expression <gL, gR> "]" (. CRT.MakeOption(gL, gR) .)
| "{" Expression <gL, gR> "}" (. CRT.MakeIteration(gL, gR) .)
| SemText <pos> (. gL := CRT.NewNode(CRT.sem, 0, 0);
gR := gL;
CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) .)
| "ANY" (. Sets.Fill(set); Sets.Excl(set, CRT.eofSy);
gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL .)
| "SYNC" (. gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL .)
(*------------------------------------------------------------------------------------*)
TokenExpr <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .)
TokenTerm <gL, gR> (. first := TRUE .)
{ WEAK "|"
TokenTerm <gL2, gR2> (. IF first THEN
CRT.MakeFirstAlt(gL, gR); first := FALSE
END;
CRT.ConcatAlt(gL, gR, gL2, gR2) .)
(*------------------------------------------------------------------------------------*)
TokenTerm <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; .)
TokenFactor <gL, gR>
{ TokenFactor <gL2, gR2> (. CRT.ConcatSeq(gL, gR, gL2, gR2) .)
[ "CONTEXT"
"(" TokenExpr <gL2, gR2> (. SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) .)
")"
(*------------------------------------------------------------------------------------*)
TokenFactor <VAR gL, gR: INTEGER> (. VAR kind, c: INTEGER; set: CRT.Set; name: CRT.Name; .)
(. gL :=0; gR := 0 .)
( Symbol <name, kind> (. IF kind = ident THEN
c := CRT.ClassWithName(name);
IF c < 0 THEN
SemErr(15);
Sets.Clear(set); c := CRT.NewClass(name, set)
END;
gL := CRT.NewNode(CRT.class, c, 0); gR := gL
ELSE (*string*)
CRT.StrToGraph(name, gL, gR)
END .)
| "(" TokenExpr <gL, gR> ")"
| "[" TokenExpr <gL, gR> "]" (. CRT.MakeOption(gL, gR) .)
| "{" TokenExpr <gL, gR> "}" (. CRT.MakeIteration(gL, gR) .)
(*------------------------------------------------------------------------------------*)
Symbol <VAR name: CRT.Name; VAR kind: INTEGER> =
( ident (. kind := ident .)
| string (. kind := string .)
) (. CRS.GetName(CRS.pos, CRS.len, name);
IF kind = string THEN FixString(name, CRS.len) END .) .
(*------------------------------------------------------------------------------------*)
Attribs <VAR attrPos: CRT.Position> =
"<" (. attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol .)
{ ANY }
">" (. attrPos.len := SHORT(CRS.pos - attrPos.beg) .).
(*------------------------------------------------------------------------------------*)
SemText <VAR semPos: CRT.Position> =
"(." (. semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol .)
{ ANY }
".)" (. semPos.len := SHORT(CRS.pos - semPos.beg) .).
END CR.